home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dskut
/
patchexe.zip
/
PATCHEXE.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-07-12
|
7KB
|
244 lines
program PatchFiles;
uses crt, dos;
const
MaxTableEntries = 1000;
type
fnstring = string[65];
rawtable = array[1..MaxTableEntries] of longint;
tabletype = ^rawtable;
ByteFile = file of byte;
CharFile = file of char;
var
verbose : boolean;
function exist(fn:fnstring):boolean;
begin
exist := fsearch(fn, '.') <> ''
end;
procedure Patch(var f:CharFile;
where:longint;
replacestring:string);
var
i:byte;
begin
writeln('Patching at ', where);
seek(f, where);
for i := 1 to length(replacestring) do
write(f, replacestring[i])
end;
procedure SilentPatch(fname:fnstring;
table:tabletype;
entries:integer;
rs:string);
var i:1..MaxTableEntries;
inf:CharFile;
begin
assign(inf, fname); reset(inf);
for i := 1 to entries do
Patch(inf, table^[i], rs);
close(inf)
end;
function max(i,j:longint):longint;
begin
if i >= j then max := i
else max := j
end;
function min(i,j:longint):longint;
begin
if i <= j then min := i
else min := j
end;
function printable(c:char):boolean;
const
PrintableCharacters : set of char
= [#32..#255];
begin
printable := c in PrintableCharacters
end;
procedure Display(var f:CharFile;
rmin, rmax, focus : longint;
highlightlength:byte);
var i:longint;
outc, c:char;
begin
seek(f, rmin);
for i := rmin to rmax do
begin
read(f, c);
if printable(c) then outc := c
else outc := #254;
if (i >= focus) and (i <= (focus+highlightlength))
then textattr := 15
else textattr := 7;
write(outc)
end;
end;
procedure InteractivePatch(fname:fnstring;
table:tabletype;
entries : integer;
rs:string);
var
inf:CharFile;
rmin, rmax, UpperLimit : longint;
i : 1..MaxTableEntries;
begin
assign(inf, fname); reset(inf);
Upperlimit := filesize(inf);
for i := 1 to entries do
begin
rmin := max (0, table^[i] - 30);
rmax := min (Upperlimit, table^[i] + 30);
Display(inf, rmin, rmax, table^[i], length(rs)-1);
writeln;
write('Replace? ');
if upcase(readkey) = 'Y' then
Patch(inf, table^[i], rs);
writeln
end;
end;
procedure Work(fname:fnstring;
sstring, rstring:string;
verbose:boolean);
label done;
var inf:CharFile;
entries : integer;
table : tabletype;
address : longint;
i : byte;
c : char;
destruct : boolean;
begin
write('Searching...');
entries := 0; new(table);
assign(inf, fname); reset(inf);
repeat
repeat
if eof(inf) then goto done;
read(inf, c);
until c = sstring[1];
address := filepos(inf);
{We'll now "try out" that chappie.}
destruct := false;
i := 2;
repeat
if eof(inf) then goto done;
read(inf, c);
if c <> sstring[i] then destruct := true;
inc(i);
until (i > length(sstring)) or destruct;
if destruct
then seek(inf, address)
else {we have a occurence of searchstring}
begin
inc(entries); write('.');
table^[entries] := address - 1
end
until eof(inf);
done:
close(inf);
if entries = 0 then
begin
writeln('No occurences of ', sstring, ' found.');
halt(0)
end;
writeln('Finished searching.');
if verbose then InteractivePatch(fname, table, entries, rstring)
else SilentPatch(fname, table, entries, rstring)
{talk to stdout, though}
end;
procedure help;
const
NumStrings = 11;
Strings : array[1..NumStrings] of string
= ('Usage:',
' patch [-v] filename string1 string2',
'',
'filename is the file which is patched.',
'You must have length(string1) = length(string2).',
'',
'Without the verbose flag, every occurence of string1 is replaced by string2.',
'',
'With verbose on:',
'Every occurence of string1 is displayed on screen, along with it''s context.',
'Iff you give a goahead, then the patch is made.');
var i:byte;
begin
for i := 1 to NumStrings do writeln(Strings[i]);
halt(1)
end;
procedure courtesy;
begin
writeln('Say');
writeln(' patch');
writeln('for more help.');
halt(1)
end;
var
firstparam : string;
filename : fnstring;
searchstring, replacestring : string;
i : byte;
begin
if (paramcount = 0) or (paramcount > 4) then help;
verbose := false;
firstparam := paramstr(1);
if firstparam[1] = '-' then {might have a -v here}
begin
if upcase(firstparam[2]) = 'V'
then verbose := true
else help;
filename := paramstr(2);
searchstring := paramstr(3);
replacestring := paramstr(4);
end
else {first parameter isn't -*}
begin
filename := paramstr(1);
searchstring := paramstr(2);
replacestring := paramstr(3)
end;
if length(searchstring) <> length(replacestring) then
begin
writeln('Searchstring and Replacestring must be of same length.');
courtesy
end;
if length(searchstring) = 0 then
begin
writeln('You have to specify some searchstring.'); courtesy
end;
if not exist(filename) then
begin
writeln('File ', filename, ' not found.'); courtesy
end;
{Now we have all the raw materials only.}
Work(filename, searchstring, replacestring, verbose)
end.